home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 52 / Amiga Format AFCD52 (Issue 136, May 2000).iso / -screenplay- / shareware / solitarexx / scripts / tress.srx < prev    next >
Text File  |  2000-02-29  |  2KB  |  116 lines
  1. /*****************************\
  2. ** Tress v1.0 for Solitarexx **
  3. **    by Michal Szafranski   **
  4. \*****************************/
  5. OPTIONS RESULTS
  6.  
  7. tex = '"Tress"'
  8. win = '"We Have a Winner"'
  9. ADDBUTTON 0 10 "Start"
  10. ADDCYCLE 1 6 '0|1|2|3' 2 'Reshuffles' 12
  11. ADDTEXT 4 24 tex 6
  12. ADDBUTTON 12 10 "Abort"
  13. ADDBUTTON 13 12 'Reshuffle'
  14. ADDTEXT 14 30 tex 6
  15. SELECTGUI 1
  16. SCREENSIZE 4 0 6 12
  17. DO i = 0 TO 17
  18.     NEWSTACK 0 1 0 (i//6) (i%6) 2*(i//6) 0 2
  19.     stack.i = RESULT
  20. END
  21. DO i = 0 TO 3
  22.     NEWSTACK 20 0 2+i 1+i 3
  23.     base.i = RESULT
  24. END
  25. NEWSTACK 21 0 1 0 3
  26. deck = RESULT
  27. ADDCARDS deck SHUFFLED
  28.  
  29. DO FOREVER
  30.     ACTION
  31.     PARSE VAR RESULT act rest
  32.     IF act = 1 THEN EXIT
  33.     IF act = 3 THEN CALL GAME
  34. END
  35.  
  36. GAME:
  37.     SELECTGUI 4
  38.     SETGADGET 14 STR tex
  39.     GETGADGET 1
  40.     resh = RESULT
  41.     CLEANUP deck
  42.     sel = 0
  43.     fin = 0
  44.     DO i = 0 TO 17
  45.         CARDSELECT deck 3
  46.         MOVECARDS deck stack.i REVERSE
  47.     END
  48.     DO FOREVER
  49.         ACTION
  50.         PARSE VAR RESULT act stack sid card
  51.         IF act = 1 THEN EXIT
  52.         IF act = 2 THEN SELECT
  53.             WHEN sel=0 & card>0 & sid = 0 THEN sel = stack
  54.             WHEN sel>0 & (sel = stack | sid = 20) THEN CALL DOBASE
  55.             WHEN sel>0 THEN CALL DOSTACKS
  56.             OTHERWISE ERRBEEP
  57.         END
  58.         IF act = 3 THEN SELECT
  59.             WHEN resh>0 & stack = 13 THEN CALL DEAL
  60.             WHEN stack = 12 THEN DO
  61.                 SELECTGUI 1
  62.                 RETURN
  63.             END
  64.             OTHERWISE ERRBEEP
  65.         END
  66.     END
  67. RETURN
  68. DOSTACKS:
  69.     CARDSELECT sel 1
  70.     PARSE VAR RESULT xx wars xx
  71.     CARDSELECT stack 1
  72.     PARSE VAR RESULT xx war xx
  73.     WHICHCARD stack
  74.     IF RESULT<3 & wars = war THEN MOVECARDS sel stack
  75.     ELSE ERRBEEP
  76.     sel = 0
  77. RETURN
  78. DOBASE:
  79.     IF sel~=stack THEN CALL CHBASE
  80.     ELSE DO i= 0 TO 3 UNTIL ok=0
  81.         stack = base.i
  82.         CALL CHBASE
  83.     END
  84.     IF ok=0 THEN DO
  85.         fin = fin +1
  86.         MOVECARDS sel stack
  87.         IF fin = 52 THEN SETGADGET 14 STR win
  88.     END
  89.     ELSE ERRBEEP
  90.     sel = 0
  91. RETURN
  92. CHBASE:
  93.     CARDSELECT sel 1
  94.     PARSE VAR RESULT kolors wars xx
  95.     CARDSELECT stack 1
  96.     PARSE VAR RESULT kolor war xx
  97.     IF kolor = '' THEN DO
  98.         kolor = kolors
  99.         war = -1
  100.     END
  101.     IF kolor = kolors & (wars - war) = 1 THEN ok = 0
  102.     ELSE ok = 1
  103. RETURN
  104. DEAL:
  105.     DO i = 0 TO 17
  106.         CARDSELECT stack.i 3
  107.         MOVECARDS stack.i deck REVERSE
  108.     END
  109.     SHUFFLECARDS deck
  110.     DO i = 0 TO 17
  111.         CARDSELECT deck 3
  112.         MOVECARDS deck stack.i REVERSE
  113.     END
  114.     resh = resh - 1
  115. RETURN
  116.